home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Graphics Programming (2nd Edition)
/
Visual Basic Graphics Programming 2nd Edition.iso
/
OldSrc
/
CH11
/
SRC
/
OBJPLIN3.CLS
< prev
next >
Wrap
Text File
|
1996-05-04
|
13KB
|
487 lines
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ObjPolyline"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Point3D and Segment3D are defined in module M3OPS.BAS as:
' Type Point3D
' coord(1 To 4) As Single
' trans(1 To 4) As Single
' End Type
'
' Type Segment3D
' pt1 As Integer
' pt2 As Integer
' End Type
Private NumPoints As Integer ' Number of points.
Private Points() As Point3D ' Data points.
Private NumSegs As Integer ' Number of segments.
Private Segs() As Segment3D ' The segments.
Private IsCulled As Boolean
' ***********************************************
' This is done at drawing time for polylines.
' ***********************************************
Public Sub ClipEye(r As Single)
End Sub
' ************************************************
' Draw the transformed points on a Form, Printer,
' or PictureBox using API functions.
' ************************************************
Public Sub DrawOrdered(canvas As Object, Optional r As Variant)
Dim seg As Integer
Dim pt1 As Integer
Dim pt2 As Integer
Dim dist As Single
Dim status As Long
' Don't draw if culled.
If IsCulled Then Exit Sub
On Error Resume Next
If IsMissing(r) Then r = INFINITY
dist = r
For seg = 1 To NumSegs
pt1 = Segs(seg).pt1
pt2 = Segs(seg).pt2
' Don't draw if either point is farther
' from the focus point than the center of
' projection (which is distance dist away).
If Points(pt1).trans(3) < dist And _
Points(pt2).trans(3) < dist Then
#If Win32 Then
status = API_MoveTo(canvas.hdc, _
Points(pt1).trans(1), _
Points(pt1).trans(2), 0&)
#Else
status = API_MoveTo(canvas.hdc, _
Points(pt1).trans(1), _
Points(pt1).trans(2))
#End If
status = API_LineTo(canvas.hdc, _
Points(pt2).trans(1), _
Points(pt2).trans(2))
End If
Next seg
End Sub
' ***********************************************
' Return the maximum transformed Z value for this
' object.
' ***********************************************
Property Get zmax() As Single
Dim best As Single
Dim z As Single
Dim i As Integer
best = Points(1).trans(3)
For i = 2 To NumPoints
z = Points(i).trans(3)
If best < z Then best = z
Next i
zmax = best
End Property
Sub Stellate(L As Single, ParamArray coord() As Variant)
Dim x0 As Single
Dim y0 As Single
Dim z0 As Single
Dim x1 As Single
Dim y1 As Single
Dim z1 As Single
Dim x2 As Single
Dim y2 As Single
Dim z2 As Single
Dim x3 As Single
Dim y3 As Single
Dim z3 As Single
Dim Ax As Single
Dim Ay As Single
Dim Az As Single
Dim Bx As Single
Dim By As Single
Dim Bz As Single
Dim nx As Single
Dim ny As Single
Dim nz As Single
Dim num As Integer
Dim i As Integer
Dim pt As Integer
num = (UBound(coord) + 1) \ 3
If num < 3 Then
Beep
MsgBox "Must have at least 3 points to stellate.", , vbExclamation
Exit Sub
End If
' (x0, y0, z0) is the center of the polygon.
x0 = 0
y0 = 0
z0 = 0
pt = 0
For i = 1 To num
x0 = x0 + coord(pt)
y0 = y0 + coord(pt + 1)
z0 = z0 + coord(pt + 2)
pt = pt + 3
Next i
x0 = x0 / num
y0 = y0 / num
z0 = z0 / num
' Find the normal.
x1 = coord(0)
y1 = coord(1)
z1 = coord(2)
x2 = coord(3)
y2 = coord(4)
z2 = coord(5)
x3 = coord(6)
y3 = coord(7)
z3 = coord(8)
Ax = x2 - x1
Ay = y2 - y1
Az = z2 - z1
Bx = x3 - x2
By = y3 - y2
Bz = z3 - z2
m3Cross nx, ny, nz, Ax, Ay, Az, Bx, By, Bz
' Give the normal length L.
m3SizeVector L, nx, ny, nz
' The normal + <x0, y0, z0> gives the point.
x0 = x0 + nx
y0 = y0 + ny
z0 = z0 + nz
' Build the segments that make up the object.
x1 = coord(3 * num - 3)
y1 = coord(3 * num - 2)
z1 = coord(3 * num - 1)
pt = 0
For i = 1 To num
x2 = coord(pt)
y2 = coord(pt + 1)
z2 = coord(pt + 2)
AddSegment x1, y1, z1, x2, y2, z2, x0, y0, z0
x1 = x2
y1 = y2
z1 = z2
pt = pt + 3
Next i
End Sub
Sub CreateNormal(Objects As Collection)
Dim pline As New ObjPolyline
Dim x1 As Single
Dim y1 As Single
Dim z1 As Single
Dim x2 As Single
Dim y2 As Single
Dim z2 As Single
Objects.Add pline
UnitNormalSegment x1, y1, z1, x2, y2, z2
pline.AddSegment x1, y1, z1, x2, y2, z2
End Sub
' ***********************************************
' Compute a normal vector for this polyline.
' ***********************************************
Sub NormalVector(nx As Single, ny As Single, nz As Single)
Dim Ax As Single
Dim Ay As Single
Dim Az As Single
Dim Bx As Single
Dim By As Single
Dim Bz As Single
Ax = Points(2).coord(1) - Points(1).coord(1)
Ay = Points(2).coord(2) - Points(1).coord(2)
Az = Points(2).coord(3) - Points(1).coord(3)
Bx = Points(3).coord(1) - Points(2).coord(1)
By = Points(3).coord(2) - Points(2).coord(2)
Bz = Points(3).coord(3) - Points(2).coord(3)
m3Cross nx, ny, nz, Ax, Ay, Az, Bx, By, Bz
End Sub
' ***********************************************
' Compute the unit normal line segment for this
' polyline.
' ***********************************************
Sub UnitNormalSegment(x1 As Single, y1 As Single, z1 As Single, x2 As Single, y2 As Single, z2 As Single)
Dim i As Integer
Dim nx As Single
Dim ny As Single
Dim nz As Single
UnitNormalVector nx, ny, nz
x1 = 0
y1 = 0
z1 = 0
For i = 1 To NumPoints
x1 = x1 + Points(i).coord(1)
y1 = y1 + Points(i).coord(2)
z1 = z1 + Points(i).coord(3)
Next i
x1 = x1 / NumPoints
y1 = y1 / NumPoints
z1 = z1 / NumPoints
x2 = x1 + nx
y2 = y1 + ny
z2 = z1 + nz
End Sub
' ***********************************************
' Compute the unit normal vector for this
' polyline.
' ***********************************************
Sub UnitNormalVector(nx As Single, ny As Single, nz As Single)
Dim D As Single
NormalVector nx, ny, nz
D = Sqr(nx * nx + ny * ny + nz * nz)
nx = nx / D
ny = ny / D
nz = nz / D
End Sub
Property Let Culled(value As Boolean)
IsCulled = value
End Property
' ***********************************************
' Return a string indicating the object type.
' ***********************************************
Property Get ObjectType() As String
ObjectType = "POLYLINE"
End Property
' ************************************************
' Add one or more line segments to the polyline.
' ************************************************
Public Sub AddSegment(ParamArray coord() As Variant)
Dim num_segs As Integer
Dim i As Integer
Dim last As Integer
Dim pt As Integer
num_segs = (UBound(coord) + 1) \ 3 - 1
ReDim Preserve Segs(1 To NumSegs + num_segs)
last = AddPoint((coord(0)), (coord(1)), (coord(2)))
pt = 0
For i = 1 To num_segs
Segs(NumSegs + i).pt1 = last
pt = pt + 3
last = AddPoint((coord(pt)), (coord(pt + 1)), (coord(pt + 2)))
Segs(NumSegs + i).pt2 = last
Next i
NumSegs = NumSegs + num_segs
End Sub
' ************************************************
' Add a point to the polyline. Return the point's
' index.
' ************************************************
Private Function AddPoint(x As Single, Y As Single, z As Single) As Integer
Dim i As Integer
' See if the point is already here.
For i = 1 To NumPoints
If x = Points(i).coord(1) And _
Y = Points(i).coord(2) And _
z = Points(i).coord(3) Then _
Exit For
Next i
AddPoint = i
' If so, we're done.
If i <= NumPoints Then Exit Function
' Otherwise create the new point.
NumPoints = NumPoints + 1
ReDim Preserve Points(1 To NumPoints)
Points(i).coord(1) = x
Points(i).coord(2) = Y
Points(i).coord(3) = z
Points(i).coord(4) = 1#
End Function
' ***********************************************
' Fix the data coordinates at their transformed
' values.
' ***********************************************
Public Sub FixPoints()
Dim i As Integer
Dim j As Integer
For i = 1 To NumPoints
For j = 1 To 3
Points(i).coord(j) = Points(i).trans(j)
Next j
Next i
End Sub
' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' object.
' ************************************************
Public Sub ApplyFull(M() As Single)
Dim i As Integer
If IsCulled Then Exit Sub
For i = 1 To NumPoints
m3ApplyFull Points(i).coord, M, Points(i).trans
Next i
End Sub
' ************************************************
' Apply a transformation matrix to the object.
' ************************************************
Public Sub Apply(M() As Single)
Dim i As Integer
If IsCulled Then Exit Sub
For i = 1 To NumPoints
m3Apply Points(i).coord, M, Points(i).trans
Next i
End Sub
' ************************************************
' Apply a nonlinear transformation.
' ************************************************
Public Sub Distort(D As Object)
Dim i As Integer
For i = 1 To NumPoints
D.Distort Points(i).coord(1), Points(i).coord(2), Points(i).coord(3)
Next i
End Sub
' ************************************************
' Write a polyline to a file using Write.
' Begin with "POLYLINE" to identify this object.
' ************************************************
Public Sub FileWrite(filenum As Integer)
Dim i As Integer
Write #filenum, "POLYLINE", NumPoints, NumSegs
' Write the points.
For i = 1 To NumPoints
Write #filenum, Points(i).coord(1), Points(i).coord(2), Points(i).coord(3)
Next i
' Write the segments.
For i = 1 To NumSegs
Write #filenum, Segs(i).pt1, Segs(i).pt2
Next i
End Sub
' ************************************************
' Draw the transformed points on a Form, Printer,
' or PictureBox.
' ************************************************
Public Sub Draw(canvas As Object, Optional r As Variant)
Dim seg As Integer
Dim pt1 As Integer
Dim pt2 As Integer
Dim dist As Single
' Don't draw if culled.
If IsCulled Then Exit Sub
On Error Resume Next
If IsMissing(r) Then r = INFINITY
dist = r
For seg = 1 To NumSegs
pt1 = Segs(seg).pt1
pt2 = Segs(seg).pt2
' Don't draw if either point is farther
' from the focus point than the center of
' projection (which is distance dist away).
If Points(pt1).trans(3) < dist And _
Points(pt2).trans(3) < dist Then _
canvas.Line _
(Points(pt1).trans(1), Points(pt1).trans(2))- _
(Points(pt2).trans(1), Points(pt2).trans(2))
Next seg
End Sub
' ***********************************************
' Perform backface removal.
' ***********************************************
Public Sub Cull(x As Single, Y As Single, z As Single)
Dim Ax As Single
Dim Ay As Single
Dim Az As Single
Dim nx As Single
Dim ny As Single
Dim nz As Single
' Compute a normal to the face.
NormalVector nx, ny, nz
' Compute a vector from the center of
' projection to the face.
Ax = Points(1).coord(1) - x
Ay = Points(1).coord(2) - Y
Az = Points(1).coord(3) - z
' See if the vectors meet at an angle < 90.
IsCulled = (Ax * nx + Ay * ny + Az * nz >= 0)
End Sub
' ************************************************
' Read a polyline from a file using Input.
' Assume the "POLYLINE" label has already been
' read.
' ************************************************
Public Sub FileInput(filenum As Integer)
Dim i As Integer
Input #filenum, NumPoints, NumSegs
' Allocate and read the points.
ReDim Points(1 To NumPoints)
For i = 1 To NumPoints
Input #filenum, Points(i).coord(1), Points(i).coord(2), Points(i).coord(3)
Points(i).coord(4) = 1
Next i
' Allocate and read the segments.
ReDim Segs(1 To NumSegs)
For i = 1 To NumSegs
Input #filenum, Segs(i).pt1, Segs(i).pt2
Next i
End Sub